home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / obsolete / contingent.pro < prev    next >
Text File  |  1997-07-08  |  4KB  |  186 lines
  1. ; $Id: contingent.pro,v 1.2 1997/01/15 04:02:19 ali Exp $
  2. ;
  3. ;  Copyright (c) 1991-1997, Research Systems Inc.  All rights
  4. ;  reserved. Unauthorized reproduction prohibited.
  5.  
  6.  
  7. Pro   MakeTable, A,Table,ColNames,RowNames,R,C,RT,CT,unit
  8.  
  9.   printf,unit,Format='(A15,$)',"               "     
  10.  
  11.   for i=0L,C-1 DO                 $
  12.    printf,unit,Format='(A11,$)',ColNames(i) 
  13.  
  14.    printf,unit,"    Total"
  15.   
  16.  
  17.    printf,unit,Format='(A15,$)',"               "     
  18.   for j=1L,C*11+1 do printf,unit,Format='(A1,$)',"_"
  19.   printf,unit," "
  20.  
  21.   for i=0L,R-1 do Begin
  22.     printf,unit,Format ='(A5,$)',"     "
  23.     for j=0L,C DO  printf,unit,Format='(A11,$)',"          |"
  24.     printf,unit," "
  25.     printf,unit,Format ='(A2,$)',"  "
  26.     printf,unit,Format='(A10,A3,A1,$)',RowNames(i),"   ","|"
  27.     for j= 0L,C-1 DO printf,unit,Format='(F10.2,A1,$)',    $
  28.                                         A(j,i),"|"
  29.     printf,unit,Format='(F8.2)',RT(i)
  30.     printf,unit,Format ='(A16,$)',"               |"
  31.     for j= 0L,C-1 DO printf,unit,Format='(A1,F8.3,A1,A1,$)',$
  32.                                        "(",Table(j,i),")","|"
  33.     printf,unit," "
  34.     printf,unit,Format='(A15,$)',"               "     
  35.     for j=1L,C*11+1 do printf,unit,Format='(A1,$)', "_"
  36.     printf,unit," "
  37.   ENDFOR
  38.   
  39.   printf,unit,Format='(A3,A10,A2,$)',"  ","Total","  "
  40.   for i = 0L,C-1 Do  printf,unit,Format='(F10.2,A1,$)',    $
  41.                           CT(i)," "
  42.   printf,unit,Format='(F10.2)',Total(CT)
  43.  
  44.   printf,unit,"  "
  45.   
  46.  
  47.   RETURN
  48.   END
  49.       
  50.  
  51.  
  52.  
  53.  
  54.  PRO Contingent, X, ChiSqr, Prob, DF, ColNames= ColNames, RowNames=RowNames,$
  55.          List_Name= LN
  56. ;+
  57. ;
  58. ; NAME:
  59. ;    CONTINGENT
  60. ;
  61. ; PURPOSE:
  62. ;    Construct a two-way contingency table from the count data in X and 
  63. ;    test for independence between two factors represented by the rows 
  64. ;    and columns of X.
  65. ;
  66. ; CATEGORY:
  67. ;    Statistics.
  68. ;
  69. ; CALLING SEQUENCE:
  70. ;    Contingent, X, ChiSqr, Prob, DF
  71. ; 
  72. ; INPUTS: 
  73. ;    X:    input array of count data. X(i,j) is the number
  74. ;        of observations at level i and j of the column
  75. ;        and row factors respectively.
  76. ;
  77. ; OUTPUT:
  78. ;    Contingency table writtem to the screen.
  79. ;
  80. ; OPTIONAL OUTPUT PARAMETERS:      
  81. ;    ChiSqr:    the statistic to test for factor independence.
  82. ;
  83. ;    Prob:    the probability of ChiSqr or something larger from a chi 
  84. ;        square distribution.
  85. ;
  86. ;    DF:    degrees of freedom
  87. ;
  88. ; KEYWORDS:
  89. ;     COLNAMES:    vector of names to label table columns.
  90. ;
  91. ;     ROWNAMES:    vector of names to label table rows.
  92. ;
  93. ;    LIST_NAME:    name of output file. default is to the screen.
  94. ;                          
  95. ; RESTRICTIONS:
  96. ;    None.
  97. ;
  98. ; COMMON BLOCKS:
  99. ;    None.
  100. ;
  101. ; SIDE EFFECTS:
  102. ;    None.
  103. ;
  104. ; PROCEDURE:
  105. ;    Calculation of standard formulas to compute ChiSqr.
  106. ;-
  107.  
  108. On_Error,2
  109. SX=Size(X)             ; Get Dimensions
  110.  
  111. if ( N_Elements(LN) NE 0) THEN openw,unit,/Get,LN    $
  112. ELSE unit = -1
  113.  
  114.  
  115. if(SX(0) NE 2) THEN BEGIN
  116.  printf,unit,            $
  117.           'Contingent- Need 2- dimensional array for Table'
  118.  goto, DONE
  119. ENDIF
  120.  
  121.  sn = where(X LT 0,count)
  122.  
  123. if count gt 0 THEN BEGIN
  124.   printf,unit,'Contingent- Data should be positive.'
  125.   goto,DONE
  126. ENDIF
  127.  
  128.  C=SX(1)                ; # of Columns
  129.  R=SX(2)                ; # of Rows
  130.  
  131.  SC= N_Elements(ColNames)
  132.  SR= N_Elements(RowNames)
  133.  
  134.  if ( SC EQ 0) THEN BEGIN
  135.    ColNames = ['Col1']
  136.    SC = SC + 1
  137.  ENDIF
  138.  
  139.  if ( SC LT C) THEN  $
  140.    for i = SC,C-1 DO                    $
  141.  ColNames = [ColNames,'Col' + StrTrim( i+1,2)]
  142.  
  143.  if ( SR EQ 0) THEN BEGIN
  144.    RowNames = ['Row1']
  145.    SR = SR + 1
  146.  ENDIF
  147.  
  148.  if ( SR LT R) THEN  $
  149.    for i = SR,R-1 DO           $
  150.      RowNames = [RowNames,'Row' + StrTrim( i+1,2)]
  151.  
  152.  GrandTotal=Total(X)
  153.  ColTotal = X#(FltArr(R)+1)
  154.  RowTotal =  (FltArr(C)+1)#X
  155.  if GrandTotal ne 0 then $
  156.    Table=ColTotal#RowTotal/GrandTotal $
  157.  else  $
  158.    message,' Must Halt since counts are all 0'
  159.  
  160.  DF=(r-1)*(c-1)
  161.  X2=X-Table
  162.  
  163.  ChiSqr= Total((X2*X2)/Table)
  164.  Prob = 1 -chi_sqr1(ChiSqr,DF)
  165.  
  166.  MakeTable,X,Table,ColNames,RowNames,R,C,RowTotal,ColTotal,$
  167. unit
  168.  
  169.  printf,unit," "
  170.  printf, unit,format =     $
  171.        '("ChiSqr=",G15.8, "   Probability =",G15.8)',  $
  172.  ChiSqr, Prob
  173.  
  174.  DONE:
  175.  if (unit NE -1) THEN Free_Lun,unit
  176.  
  177.  RETURN
  178.  END
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.